perm filename MPRNT.F4[1,MUS] blob
sn#078086 filedate 1973-12-16 generic text, type T, neo UTF8
00100 C MPRNT.F4********** DRAWS MUSIC ON THE PLOTTER OR XGP **********
00200 C *** READS DATA FROM CLFX, TAIL, FERM, BREP, REST, DRAW1, DRAW2
00300 C LOAD WITH PPSRT, PLTCMD, NOTWRT, ITMSBX, TREST, CLFZ, LOOK
00400
00500 IMPLICIT INTEGER(A-Q,S-Z)
00600 REAL DIS,PWDS,DISX,A,B,STFF,CENTR,POS
00700 COMMON /DL/IXRX,SAVER,NAME
00800 DIMENSION V(78),LIST(200)
00900 COMMON/FRMT/F78F(1),FA1(1),FA5(1),ASK/SIZ/RSZ,JCEN,KCEN
01000 COMMON/ALF/INP(3),ML/XRN/RN(4000)/STF/RSTFAC(8),RSTJC
01100 COMMON /PLTR/PLT,RHT,DIS/PTR/PWDS(250),ITEM,L,I,IX
01200 COMMON RJB,JA,CENTR,JB,RJQ(20),JQ(20)/POSI/STFF(8),JJB,POS
01300 COMMON/DPY/GO,RXGP,TOP,BOT
01400 EQUIVALENCE (JC,JQ(1)),(JD,JQ(2)),(JE,JQ(3)),(RJE,RJQ(3))
01500 1,(RJF,RJQ(4)),(JG,JQ(5)),(JH,JQ(6)),(JF,JQ(4)),(RJG,RJQ(5))
01600 1,(RJD,RJQ(2)),(RJC,RJQ(1)),(I1,INP(1)),(V,RN(3000))
01700 1,(LIST,RN(3100))
01800 DATA STFF/-369.0,-246.0,-123.0,0.0,123.0,246.0,369.0,450.0/
01900 1 ,IP/'P'/
02000
02100 TOP2=-999
02200 RXGP=0
02300 I1=0
02400 C RESTART PROG. OR TYPE 'F' TO FINISH PLOTTER.(IT'S NOT AUTOMATIC.)
02500 2 PLOTIT=0
02600 RSZ=.845
02700 TOP=-999
02800 BOT=999
02900 PLT=0
03000 PWDS(1)=1.
03100 EDX=-1
03200 DO 1402 K=1,8
03300 1402 RSTFAC(K)=1.
03400 M=1
03500 ITEM=0
03600 IXRX=0
03700 I=1
03800 58 GO=-1
03900 GO TO 5504
04000
04100
04200 11 CALL NOTWRT
04300 57 IF(PLT)GO TO 6120
04400 ITEM=ITEM+1
04500 IF(EDX.NE.-1.AND.M.LT.I)GO TO 6120
04600 IF(PLOTIT.EQ.-2)GO TO 2311
04700 PWDS(ITEM+1)=I
04800 PLT=0
04900 GO=-1
05000
05100 5504 IF(I1.EQ.IP)GO TO 2311
05200 59 TYPE 56
05300 ACCEPT 89,INP
05400 311 JA=0
05500 IF(I1.NE.IP)GO TO 85
05600 2311 CALL PLTCMD
05700 IF(PLOTIT.EQ.0)GO TO 3005
05800 I1=IP
05900 PLOTIT=-1
06000 C 'PXG' OR 'PXC' GOES TO 'PLOT COMMAND' ROUTINE
06100 89 FORMAT(72A1)
06200
06300 6531 M=1
06400 EDX=-1
06500 DO 5532 K=1,9
06600 5532 JQ(K)=RJQ(K)
06700 590 IF(PLOTIT.EQ.-1)GO TO 121
06800 I1=0
06900 243 RJB=1.
07000 C TO RUN THROUGH DATA.
07100 241 RSZ=.845*RJB
07200 RJB=0
07300 RJC=0
07400 RJD=0
07500 TOP=-999
07600 BOT=999
07700 C GOES TO PLOTTER
07800 85 M=1
07900 I=PWDS(ITEM+1)
08000 ITEM=0
08100 8852 PLT=1
08200 EDX=0
08300 GO=0
08400 GO TO 6120
08500
08510 60 IF(JA.NE.88)GO TO 601
08520 RSTFAC(JC+4)=RJB
08525 C FOR STAFF SIZE FACTOR WITHOUT STAFF.
08530 GO TO 57
08600 601 RSTJC=RSTFAC(JC+4)
08700 5541 POS=STFF(JC+4)
08800 JB=RHORZ(RJB)
08900 C LINE IS DIVIDED INTO 200 POINTS.
09000 CENTR=POS
09100 551 IF(JA.EQ.4.OR.JA.EQ.10)GO TO 25
09200 IF(JA.EQ.7)GO TO 81
09300 IF(JA.LE.12.OR.JA.EQ.30)GO TO 11
09400 IF(JA.EQ.18)GO TO 80
09500 CALL ALPHA
09600 GO TO 57
09700
09800 81 CALL KSIG
09900 GO TO 57
10000
10100 80 CALL METER
10200 GO TO 57
10300
10400 25 CALL ITMSUB
10500 C BAR LINES, BEAMS, STAFF LINES ****
10600 GO TO 57
10700
10800 3005 REWIND 21
10900 C GUARDS AGAINST LOSSAGE!
11000 PLOTIT=-2
11100 CALL IFILE(21,NAME)
11200 C JUMP TO READ BIG FILES
11300 2200 J=ITEM+1
11400 2202 READ(21),X,Y,
11500 1 (PWDS(K),K=J,X+J),(RN(K),K=I,Y+I-2),ISCR,(V(K),K=1,ISCR),
11600 1 LCNT,(LIST(K),K=1,LCNT)
11700 READ(21),RSTFAC,STFF
11800 ITEM=ITEM+X
11900 I=Y
12000 GO TO 6531
12100 121 IF(PLOTIT.EQ.0)GO TO 5504
12200 5121 CALL PLTSRT
12300 C IF P5=0 MOVES UP AT START, IF P6=0 MOVES UP AT END.
12400 PLT=-1-JH
12500 C (JH) P8=1 OR 2 FOR 2-PASS PLOTS
12600 M=I
12700 I=I+M-1
12800 IF(RJB.EQ.0)RJB=1.
12900 DIS=RJB*1.24
13000 IF(RJC.EQ.0)RJC=RJB
13100 RHT=RJC*1.2
13200 C 1.24 AND 1.2 ARE TO FIT 8 1/2 X 11 FORMAT
13300 BOT=-BOT*RHT
13400 IF(TOP2.EQ.-999)GO TO 8121
13500 BOT=BOT+TOP2
13600 GO TO 9121
13700 8121 CALL PLOTS(K)
13800 RXGP=995.-BOT
13900 9121 NOMOVE=RJF+RJG*148.*RJC
14000 C RJF=1 FOR NO MOVE AT END. RJG=# OF STAVES TO MOVE FOR NEW STAFF 0.
14100 IXGP=JD
14200 C (JD) P4=1 FOR XGP OUTPUT
14300 IF(JE.NE.0)GO TO 1122
14400 IF(RJD.EQ.0)GO TO 6121
14500 IF(TOP2.NE.-999)RXGP=RXGP-BOT
14600 C MOVES 0 POINT OVER EACH TIME.
14700 GO TO 1122
14800 6121 CALL PLOT(0,BOT,-3)
14900 C MOVES PLOTTER UP IF P5=0.
15000 1122 IXRX=IXGP
15100
15200 C NEXT RUNS THROUGH DATA WITH NEW CHANGES.
15300 6120 IF(M.GE.I)GO TO 7120
15400 CNT=RN(M)
15500 DO 6220 K=CNT+1,10
15600 JQ(K)=0
15700 6220 RJQ(K)=0
15800 JA=RN(M+1)
15900 M=M+2
16000 RJB=RN(M)
16100 DO 9120 K=1,CNT
16200 RJQ(K)=RN(M+K)
16300 9120 JQ(K)=RJQ(K)
16400 M=CNT+M+1
16500 IF(EDX.LE.0)GO TO 60
16600 GO TO 5504
16700
16800 7120 M=1
16900 IF(EDX)GO TO 71201
17000 IF(PLT.EQ.1)EDX=-1
17100 PLT=0
17200 C RETURNS FOR 'SL'=SAVE LAST
17300 GO TO 5504
17400 71201 X=50*RHT
17500 TOP=TOP*RHT+X
17600 IF(NOMOVE.NE.0)TOP=0
17700 IF(NOMOVE.GT.1)TOP=NOMOVE
17800 IF(IXGP.EQ.0)CALL PLOT(0,TOP,3)
17900 TOP2=TOP
18000 GO TO 2
18100 C TO MOVE 'PLOTTER' FOR XGP OUTPUT
18200 C MOVES PLOTTER UP
18300 C ALWAYS START PLOT WITH BOTTOM UNIT ON PAGE AND WORK UP.
18400
18500 56 FORMAT(' PXG OR PXC'/)
18600 END